home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
SGI Hot Mix 14
/
Hot Mix 14.iso
/
HTML
/
vendors
/
finesse
/
examples
/
perl
/
stars
< prev
Wrap
Text File
|
1996-06-27
|
6KB
|
256 lines
#!/usr/local/bin/perl
# FINESSEAPPLICATIONKEY sSoCbg^X_HzYv
$ENV{'FINESSEPATH'} = '/usr/local/finesse'
if !$ENV{'FINESSEPATH'};
require("$ENV{'FINESSEPATH'}/fsperlinit");
# read primitive database and prepare lists
require("$ENV{'FINESSEPATH'}/examples/perl/.starsdb");
&make_random_lists;
# define user interface
$choicelabel = "Random
Choice";
$windef = "FsWindow -name starswin
-title stars;
FsRadio -var fsmode -label Mode: -winstat touch
-fsbutton fsmode
-items 'Beginner Expert Answer';
FsForm -name topform
-orientation horizontal;
FsList -label Constellation:
-inputsep '/'
-outputsep '/'
-mode single
-items '$list_of_consts'
-var const
-name const
-expert show
-parent topform
-nvisible 15;
FsList -label 'List of Stars:'
-inputsep '/'
-outputsep '/'
-items '$list_of_stars'
-nvisible 15
-var fsstars
-name fsstars
-expert show
-parent topform
-mode single;
FsLabel -label
'Press \\'Random Choice\\' to select constellation:'
-name fsresult;
FsList -label 'Relation:'
-inputsep '/'
-outputsep '/'
-items ''
-var rel
-name rel
-nvisible 5;
FsPushButton -label '$choicelabel'
-name choice -fsbutton Choice
-winstat touch;
FsPushButton -label Show -name show
-winstat touch;
FsPushButton -label Clear -name clear
-winstat touch;
FsPushButton -label Exit -fsbutton a;
";
&Fsopen(@ARGV);
&Fsdisplay("-w", "$windef", "-n", "starswin");
while () {
if ( $fsbutton eq "fsmode" ) {
# Change of mode in radio box 'Mode'
@fsdargs = &get_fsmode_args($fsmode);
} elsif ( $fsbutton eq "Choice" ) {
# Button 'Choice' was pressed
if (( $fsmode eq "Beginner" ) ||
( $fsmode eq "Expert" )) {
@fsdargs = &get_choice_args($fsmode);
}
} elsif ( $fsbutton eq "Show" ) {
# Button 'Show' was pressed
if ( $fsmode eq "Beginner" ) {
@fsdargs =
&get_beginner_args($allstars{$const},$fsstars);
} elsif ( $fsmode eq "Expert" ) {
@fsdargs =
&get_expert_args($allstars{$const},$fsstars);
} elsif ( $fsmode eq "Answer" ) {
@fsdargs = &get_answer_args($const,$fsstars);
}
} elsif ( $fsbutton eq "Clear" ) {
@fsdargs = @clear;
} else {
last;
}
&Fsdisplay("-n", "starswin", @fsdargs);
}
&Fsclose;
#
# functions
#
sub make_random_lists {
# make list of stars and constellations
srand(time|$$);
foreach $value (values (%allstars)) {
@all_stars = (@all_stars, split('/', $value));
}
@all_consts = keys(%allstars);
# make lists random for window declaration
push(@rand_stars, splice(@all_stars, rand @all_stars, 1))
while (@all_stars);
$list_of_stars = join('/', @rand_stars);
push(@rand_const, splice(@all_consts, rand @all_consts, 1))
while (@all_consts);
$list_of_consts = join('/', @rand_const);
# prepare clearing of lists
@clear = ("-v", "const=*[unselect]",
"-v", "fsstars=*[unselect]",
"-v", "rel=*[delete]",
"-r", "fsresult:labelString:");
}
sub get_fsmode_args {
# prepare window setup according to selected mode
if ( $_[0] eq "Beginner" ) {
$fslabel = "Push Choice to Select Constellation:";
$constpol = "XmBROWSE_SELECT";
$starspol = "XmBROWSE_SELECT";
} elsif ( $_[0] eq "Expert" ) {
$fslabel = "Push Choice to Select Constellation:";
$constpol = "XmBROWSE_SELECT";
$starspol = "XmEXTENDED_SELECT";
} elsif ( $_[0] eq "Answer" ) {
$fslabel = "Select Constellation and Stars:";
$constpol = "XmEXTENDED_SELECT";
$starspol = "XmEXTENDED_SELECT";
}
("-r", "fsresult:labelString:$fslabel", @clear,
"-r", "const:selectionPolicy:$constpol",
"-r", "fsstars:selectionPolicy:$starspol");
}
sub get_choice_args {
# make random choice in list of stars
if ( $_[0] eq "Beginner" ) {
$fslabel =
"Select corresponding main star and press 'Show'";
} elsif ( $_[0] eq "Expert" ) {
$fslabel =
"Select corresponding stars and press 'Show'";
}
("-v", "rel=*[delete]", "-v",
"const=*[unselect]/$rand_const[rand(@rand_const)]",
"-r", "fsresult:labelString:$fslabel");
}
sub get_answer_args {
# determine answer for selections
local(%MARK, $entry, @chosenstars);
# begin with chosen constellations
if ("$_[0]") {
@const = split(/\//,$_[0]);
foreach (@const) {
@stars = split(/\//, $allstars{$_});
push(@chosenstars, @stars);
}
}
# add chosen stars not yet processed
if ("$_[1]") {
@stars = split(/\//, $_[1]);
grep($MARK{$_}++, @askedstars);
@remainingstars = grep(!$MARK{$_}, @stars);
push(@chosenstars, @remainingstars);
}
foreach (@chosenstars) {
$entry = "$entry$_: $genitive{$_}/";
}
("-v", "rel=*[delete]/$entry*[unselect]");
}
sub get_beginner_args {
# compare main star with guess
if ("$_[0]" && "$_[1]") {
($answer) = split(/\//,$_[0]);
if ( "$answer" eq "$_[1]" ) {
$fslabel = "Congratulations!" ;
} else {
$fslabel = "Sorry." ;
}
("-v", "rel=*[delete]/$answer: $genitive{$answer}/*[unselect]",
"-r", "fsresult:labelString:$fslabel");
} else {
$fslabel =
"Select constellation and main star first." ;
("-r", "fsresult:labelString:$fslabel");
}
}
sub get_expert_args {
# compare all stars of const with guess
if ("$_[0]" && "$_[1]") {
local(%MARK);
@answer = split(/\//,$_[0]);
@guess = split(/\//,$_[1]);
grep($MARK{$_}++, @answer);
$hits = grep($MARK{$_}, @guess);
$misses = @answer - $hits;
$errors = @guess - $hits;
$fslabel =
"Hits: $hits, Misses: $misses, Errors: $errors";
("-v", "rel=*[delete]/$_[0]/*[unselect]",
"-r", "fsresult:labelString:$fslabel");
} else {
$fslabel = "Select constellation and stars first." ;
("-r", "fsresult:labelString:$fslabel");
}
}